home *** CD-ROM | disk | FTP | other *** search
/ TeX 1995 July / TeX CD-ROM July 1995 (Disc 1)(Walnut Creek)(1995).ISO / web / clip / unix / ex01_b.pas < prev    next >
Encoding:
Pascal/Delphi Source File  |  1993-11-16  |  4.7 KB  |  120 lines
  1.     (***************  #file "palindrome.pas"  ***********************)
  2.     (****************************************************************)
  3.     (* Program: Palindrome filter program.                          *)
  4.     (* Purpose: To filter the palindromic lines from a given input  *)
  5.     (*          file to a specified output file.                    *)
  6.     (****************************************************************)
  7.     PROGRAM PALINDROME (INPUT, OUTPUT, IN_FILE, OUT_FILE);
  8.  
  9.     CONST
  10.         MAX_L = 132;
  11.     TYPE
  12.         ABSTRACT  = (DEFINED, UNDEFINED);
  13.         TEXT_LINE =     RECORD
  14.                             CHARS: ARRAY[1..MAX_L] OF CHAR;
  15.                             LENGTH: 0..MAX_L;
  16.                         END (*RECORD*);
  17.     VAR
  18.         IN_FILE, OUT_FILE: TEXT;
  19.         IN_LINE,
  20.         LETTERS:        TEXT_LINE;
  21.         IS_PALINDROME:  BOOLEAN;
  22.         IN_CHAR:    CHAR;
  23.         I:          INTEGER;
  24.         J:          INTEGER;
  25.         T :         INTEGER;
  26.  
  27.     BEGIN
  28.         OPEN (IN_FILE,  'TESTDATA.IN',  'old');     RESET   (IN_FILE);
  29.         OPEN (OUT_FILE, 'TESTDATA.OUT', 'unknown'); REWRITE (OUT_FILE);
  30.  
  31.         (*****************  Palindrome (body)  **********************)
  32.         (** Copy the lines of the IN_FILE that are palindromic to  **)
  33.         (** the OUT_FILE.                                          **)
  34.         WHILE NOT EOF (IN_FILE) DO
  35.         BEGIN
  36.             (*****************  Palindrome (1)  *********************)
  37.             (** Read a line from IN_FILE into IN_LINE. The letters **)
  38.             (** of this line are copied to LETTERS.                **)
  39.             IN_LINE.LENGTH := 0;
  40.             LETTERS.LENGTH := 0;
  41.             WITH IN_LINE DO
  42.             WHILE NOT EOLN (IN_FILE) DO
  43.             BEGIN
  44.                 READ (IN_FILE, IN_CHAR);
  45.                 LENGTH := LENGTH + 1;
  46.                 CHARS[LENGTH] := IN_CHAR;
  47.                 IF IN_CHAR IN ['A'..'Z', 'a'..'z'] THEN
  48.                 WITH LETTERS DO
  49.                 BEGIN
  50.                     LENGTH := LENGTH + 1;
  51.                     CHARS[LENGTH] := IN_CHAR;
  52.                 END (*WITH/IF*);
  53.             END (*WHILE/WITH*);
  54.  
  55.             (*****************  Palindrome (test)  ******************)
  56.             (** Check contents of IN_LINE and LETTERS.             **)
  57.             WRITELN;
  58.             WRITELN ('============  DEBUGGING INFORMATION  ===============');
  59.             WRITELN ('Contents of buffer IN_LINE: ');
  60.             WRITE   ('>>>>');
  61.             WITH IN_LINE DO
  62.             FOR T := 1 TO LENGTH DO WRITE (OUTPUT, CHARS[T]);
  63.             WRITE   ('<<<<');
  64.             WRITELN;
  65.             WRITELN ('Contents of buffer LETTERS:  ');
  66.             WRITE   ('>>>>');
  67.             WITH LETTERS DO
  68.             FOR T := 1 TO LENGTH DO WRITE (OUTPUT, CHARS[T]);
  69.             WRITE   ('<<<<');
  70.             WRITELN;
  71.             WRITELN ('==========  END OF DEBUGGING INFORMATION  ==========');
  72.             WRITELN;
  73.             (*************  End of Palindrome (test)  ***************)
  74.  
  75.             (*****************  End of Palindrome (1)  **************)
  76.  
  77.             READLN (IN_FILE);
  78.  
  79.             (*****************  Palindrome (2)  *********************)
  80.             (** Test palindromicity of LETTERS. Set IS_PALINDROME  **)
  81.             (** to reflect the result of the test.                 **)
  82.             WITH LETTERS DO
  83.             BEGIN
  84.                 (* Transform lowercase to uppercase.                *)
  85.                 FOR I := 1 TO LENGTH DO
  86.                 IF CHARS[I] IN ['a'..'z']
  87.                 THEN CHARS[I] :=
  88.                      CHR(ORD(CHARS[I]) - ORD('a') + ORD('A'));
  89.  
  90.                 (* Perform the palindromicity test.                 *)
  91.                 IS_PALINDROME := TRUE;
  92.                 I := 1;
  93.                 WHILE IS_PALINDROME AND (I <= LENGTH DIV 2) DO
  94.                 IF CHARS[I] = CHARS[LENGTH-I+1] THEN
  95.                     I := I + 1
  96.                 ELSE
  97.                     IS_PALINDROME := FALSE;
  98.             END (*WITH*);
  99.             (*****************  End of Palindrome (2)  **************)
  100.  
  101.  
  102.             IF IS_PALINDROME THEN
  103.             BEGIN
  104.                 (*****************  Palindrome (3)  *****************)
  105.                 (** Write IN_LINE to OUT_FILE.                     **)
  106.                 WITH IN_LINE DO
  107.                 BEGIN
  108.                     FOR J := 1 TO LENGTH DO
  109.                         WRITE (OUT_FILE, CHARS[J]);
  110.                 END (*WITH*);
  111.                 (*************  End of Palindrome (3)  **************)
  112.  
  113.                 WRITELN (OUT_FILE);
  114.             END (*IF*);
  115.         END (*WHILE*);
  116.         (*************  End of Palindrome (body)  *******************)
  117.  
  118.     END (*PALINDROME*).
  119.     (*******************  End of palindrome.pas  ********************)
  120.